home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGSCAL
/
OASIS41A.LZH
/
SCL.DOC
< prev
next >
Wrap
Text File
|
1988-05-22
|
18KB
|
601 lines
{$R-,S+,I+,D+,T-,F-,V-,B-,N-,L+ }
{$M 16384,0,655360 }
unit scl;
interface
uses dos,crt;
TYPE
string128 = string[128];
String80 = STRING[80];
String10 = STRING[10];
String20 = STRING[20];
String13 = STRING[13];
String40 = STRING[40];
String70 = STRING[70];
CONST
{Increase the following values if required}
Max_Error_Messages = 100; {max 100 recs in file ???.ERR}
Max_Input_Messages = 400; {max 400 recs in file ???.MSG}
Max_Heap_Screens = 20; {max 20 formats in Mem simultaneously}
Screenfile_Ext : string10 = '.scs'; {Change for other file name}
Indexfile_Ext : string10 = '.sci'; {extensions}
Errorfile_Ext : string10 = '.err';
Messagefile_Ext: string10 = '.msg';
{Help system }
Code_Help_Field : INTEGER = 1060; {F2 Key to display field help screen}
Code_Help_Format : INTEGER = 1059; {F1 Key to display format help screen}
Auto_Help_Set : BOOLEAN = TRUE; {Autohelp feature enabled}
Autohelp_Screen = 'AUTOHELP'; {Name of autohelp format}
Maxerrors : INTEGER = 3; {Display Autohelp after 3 consecutive
input errors.}
{Country information to be used by SCL; 0=Use System setting. Change if other
country code is to be used}
CONST
Scl_Country : INTEGER = 0;
{Cursor wrap around feature; Set to TRUE if no wraparound is desired (Mouse) }
No_Wrap : BOOLEAN = FALSE;{Overrides format specs if TRUE}
{Field blinker}
Timer_Intervall : INTEGER = 3; {Increase for slower blinking fields}
{Beep Sound}
Beep_Off : BOOLEAN = FALSE; {SCL beeps in case of input errors}
Beep_Time : INTEGER = 3; {3 bursts of about 50 ms each}
Beep_Frequency_1 : INTEGER = 200; {First frequency 200 hertz}
Beep_Frequency_2 : INTEGER = 350; {Second frequency 350 hertz}
(*pointers to the background tasks; inilialized during 'Select_format_file'
to point to 'dummy' *)
lp_background_pointer:pointer=nil;
hp_background_pointer:pointer=nil;
{Messages}
Input_Msg_Set : BOOLEAN = TRUE; {Input messages are not supressed}
Error_Msg_Set : BOOLEAN = TRUE; {error messages are not supressed}
{**************************************************************************}
{ NOTE:
All constants named 'Code...' define keyboard keys to perform certain
functions within SCL.
They are the ASCII Codes of the appropriate keys with 1000 added, if they
return a two byte (extended) code, starting with an ESC character.
Example: Code_F7. The F7 key returns a two byte code <ESC> 'A'.
Therefore it is coded as follows: 1000 + 65 = 1065. (65 is the ASCII Value
of 'A'.
(The same scheme applies to all character coding in SCL)
***************************************************************************}
{Characters to be used for the 'Marked field attribute'}
Mark_Field_Left : Byte = 16; {ASCII 16}
Mark_Field_Right : Byte = 17; {ASCII 17}
{Characters representing 'Yes' and 'No'. Used for boolean variables.
Change for other languages.}
Code_Yes : INTEGER = 89; {'Y'}
Code_No : INTEGER = 78; {'N'}
{Special Keys, change for non standard keyboard layouts}
Code_Cancel_Act : INTEGER = 1061; {F3 to cancel a field change}
Code_Abort : INTEGER = 1068; {F10 to unconditionally abort a format}
Code_Escape : INTEGER = 27;
Code_Home : INTEGER = 1071;
Code_Tab : INTEGER = 9;
Code_Ctrltab : INTEGER = 1116; {Internal use, don't change}
Code_Rtab : INTEGER = 1015;
Code_Return : INTEGER = 13;
Code_Left : INTEGER = 1075;
Code_Right : INTEGER = 1077;
Code_Down : INTEGER = 1080;
Code_Up : INTEGER = 1072;
Code_End : INTEGER = 1079;
Code_Ins : INTEGER = 1082;
Code_Del : INTEGER = 1083;
Code_Backspace : INTEGER = 8;
Code_Pgup : INTEGER = 1073;
Code_Pgdown : INTEGER = 1081;
{Codes for function keys}
Code_F1 : INTEGER = 1059;
Code_F2 : INTEGER = 1060;
Code_F3 : INTEGER = 1061;
Code_F4 : INTEGER = 1062;
Code_F5 : INTEGER = 1063;
Code_F6 : INTEGER = 1064;
Code_F7 : INTEGER = 1065;
Code_F8 : INTEGER = 1066;
Code_F9 : INTEGER = 1067;
Code_F10 : INTEGER = 1068;
{'Do nothing' character. Don't change.}
Code_Noop = 255;
{Permitted characters for the different types of variables}
Anything_Set : SET OF byte = [1..6,8,14..27,32..254];
Integer_Set : SET OF byte = [32,43,45,48..57];
Real_Set : SET OF byte = [32,43,45,46,48..57];
Alpha_Set : SET OF byte = [32,65..90,97..122,128..167];
{Message to be displayed in case of fatal SCL error, change for other language}
Fatal_Msg_1 = 'FATAL ERROR IN SCREENHANDLER: ';
Fatal_Msg_2 = 'ERROR NR: ';
Fatal_Msg_3 = 'PROGRAM ABORTED.';
{SCL internal Flags}
format_aborted : BOOLEAN = FALSE;
Msgfile_Exists : BOOLEAN = FALSE;
Field_Inverted : BOOLEAN = TRUE;
Blink_count : Integer = 0;
beep_switch : boolean = true;
beep_count : integer = 0;
{System dependant info. Don't change}
minint : integer = -32767;
Max_Format_Width = 80; {Max chars per line}
Max_Format_Height = 25; {Max lines on display}
Key_Buffer_Size = 50; {Type ahead buffer size}
Max_Format_Fields = 50; {Max 50 fields on a format}
Space : CHAR = ' '; {That's what a space looks like}
save_exitproc : pointer = nil;
TYPE
Msgrec = String70;
Fieldkinds = (Variable,Textfield,Constant);
Contkinds = (I,R,Alpha,Anything,Bool);
Position = (Left,Right,Center);
Line = STRING[Max_Format_Width];
Tenfunctions = ARRAY[1..10] OF BOOLEAN;
Tenchars = ARRAY[1..10] OF INTEGER;
Linearray = ARRAY[1..Max_Format_Height] OF Line;
Inputbuffer = ARRAY[0..Key_Buffer_Size] OF INTEGER;
Dta_Type = RECORD
Reserved : ARRAY[1..21] OF Byte;
Attribute: Byte;
Time, Date, Filesizelo, Filesizehi : INTEGER;
Name : STRING[13];
END;
Fieldrec = RECORD
Field_Msg_Nr :INTEGER; {ptr to rec in *.msg}
Field_Help_Screen :String10;{help screen for this field}
Fx, {column where this field starts}
Fy, {row of this field}
Fl :Byte; {field length}
Ld_Char :CHAR; {the char for left delimiter}
Rd_Char :CHAR; {char for right delimiter}
Next_Tab, {the field to go to if tab is pressed}
Prev_Tab, {the field to go to if rtab is pressed}
Look_Norm, {char attribute byte}
Look_Act_Color, {char attribute byte}
Look_Act_Mono, {special coding, see above}
Look_Sel_Color, {char attribute byte}
Look_Sel_Mono :Byte;
Inp_Required :BOOLEAN;
Field_Type :Fieldkinds;
Fill_Char :CHAR;
Check_Each_Char :BOOLEAN;
Cont_Type :Contkinds;
Justify :Position;
Cont_Min,
Cont_Max :REAL;
Nr_Of_Dec,
Group_First,
Group_Last :Byte;
Selected,
Highlighted :BOOLEAN;
END;
Fieldarray = ARRAY[1..Max_Format_Fields] OF Fieldrec;
Screen = RECORD
Format_Status :Byte;
Screenname :String10;
Format_Help_Screen :String10;
F_Int :Tenfunctions;
Char_Int :Tenchars;
Error_Field,
Message_Field,
Total_Fields,
First_Tab,
Last_Tab,
Format_Width,
Format_Height :Byte;
Abort_Ok,
Wrap_Ok :BOOLEAN;
Spare :BOOLEAN;
Format_Color :Byte;
Format_Image :Linearray;
Field :Fieldarray;
Filler :ARRAY[1..119] OF Byte; {to get to 36*
128 bytes}
END;
Sckeyrec = RECORD
Deleted :BOOLEAN;
Scname :String10;
Sckey :INTEGER;
END;
Screcptrtyp = ^heapscreenrec;
Scstackrec = RECORD
Saved_Mx,
Saved_My,
Saved_Fn,
Saved_Xoff,
Saved_Yoff,
Recovery_Left,
Recovery_Right,
Recovery_Top,
Recovery_Bottom,
Saved_Status,
Saved_Char_Code,
Saved_Err :INTEGER;
saved_fcs :string80;
Saved_Char_Image :CHAR;
saved_editmode,
Saved_Char_Interrupt,
Saved_Fieldend,
Format_End :BOOLEAN;
Screc :Screcptrtyp;
END;
Heapscreenrec = Screen;
Scr_Pos = RECORD
Txt,
Att :Byte;
END;
Scrmap = ARRAY[1..25,1..80] OF Scr_Pos;
Scstacktyp = ARRAY[1..Max_Heap_Screens] OF Scstackrec;
Msgptr = ^msg;
Msg = String70;
Var
Screen_Color_Translation_Table: Array[0..255] of Byte; {screen att xlation}
Country, {contains country code used}
Date_Format :INTEGER; {0=mmddyy, 1=ddmmyy}
Date_Separator:CHAR; {from country info}
Time_Separator:CHAR; {from country info}
Currency :String10; {from country info}
{above info is set during SCL init and can be inquired anytime}
old_clock : pointer;
Glb_regs : registers;
Spaces : String80;
Scmsg : ARRAY [1..500] OF Msgptr;
Errorfile : TEXT;
Msgfile : FILE OF Msgrec;
Stack : Scstacktyp;
Keyrec : Sckeyrec;
Active_Format,
Active_Field : INTEGER;
Screens : FILE;
Screenindex : FILE OF Sckeyrec;
Inbuff : Inputbuffer;
Buffbot,
Bufftop : INTEGER;
Editmode,
Mono_Adapter,
Fieldend : BOOLEAN;
Progpath : String80;
Stack_Debth,
Xoff,
Yoff,
Activeformat,
R_ptr,
W_ptr,
S_ptr,
Scmsgnr,
Errorcount : INTEGER;
Char_Image : CHAR;
Char_Code,
Mx,
My,
Glb_Status,
Glb_Error : INTEGER;
Error_Msg_Present,
Msg_Present : BOOLEAN;
Fieldcontsave : String80;
Active_Format_File
: String10;
Checkrequired,
Glb_Ok,
user_function,
begin_of_field,
end_of_field,
end_of_format : BOOLEAN;
Newtime : REAL;
Lasterror : INTEGER;
Color_True : BOOLEAN;
Screen_Mode : byte;
Mscreen : Scrmap Absolute $b000:$0000;
Cscreen : Scrmap Absolute $b000:$8000;
(*Datacom related Declarations*)
CONST
Dc_Parity : CHAR = 'E';
Dc_Stopbits : INTEGER = 1;
Dc_Speed : INTEGER = 9600;
Dc_Charsize : INTEGER = 7;
Dc_int_Save : pointer = nil;
DC_Buffer_Size = 2100;
DC_Rx_Buff_Bottom:INTEGER= 0;
DC_Rx_Buff_Top : INTEGER = 0;
Dc_Open : BOOLEAN = FALSE;
Tx_Char_Timeout: INTEGER = 500;
Rts_Cts_Timeout: INTEGER = 500;
Rts_Holdover : INTEGER = 0;
Rts_Cts_Delay : INTEGER = 30;
Bcc_Set : BOOLEAN = TRUE;
(*Datacom Control Characters*)
Nul = $0;
Soh = $1;
Stx = $2;
Etx = $3;
Eot = $4;
Enq = $5;
Ack = $6;
Bel = $7;
Con = $7;
Bs = $8;
Ht = $9;
Lf = $a;
Vt = $b;
Ff = $c;
Cr = $d;
S0 = $e;
S1 = $f;
Dle = $10;
Dc1 = $11;
Dc2 = $12;
Dc3 = $13;
Dc4 = $14;
Nak = $15;
Syn = $16;
Etb = $17;
Can = $18;
Em = $19;
Sub = $1a;
Esc = $1b;
Fs = $1c;
Gs = $1d;
Rs = $1e;
Us = $1f;
Pol = $70;
Sel = $71;
Fsl = $73;
Bsl = $74;
Del = $7f;
(*Datacom Receive Buffer*)
VAR
DC_Rx_Buffer : ARRAY[0..DC_Buffer_Size] OF Byte;
Bcc : Byte;
FUNCTION Capital(wstr: String): String;
FUNCTION Stripleft(wstr: String): String;
FUNCTION Stripright(wstr: String): String;
PROCEDURE Strip(VAR wstr:String;VAR Len:INTEGER);
FUNCTION Charstring(Whatchar:CHAR;Len:INTEGER):String;
PROCEDURE Ftab(VAR wstr:String;Fill_Char:CHAR;Just:Position;Len:INTEGER);
FUNCTION Justify_Left(STR:String;Len:INTEGER):String;
FUNCTION Justify_Right(STR:String;Len:INTEGER):String;
FUNCTION Justify_Center(STR:String;Len:INTEGER):String;
PROCEDURE Frontstring(STR:String;VAR Head,Tail:String);
FUNCTION X_Max:INTEGER;
FUNCTION Y_Max:INTEGER;
FUNCTION St(I:INTEGER):String80;
FUNCTION Nr(St:String80):Integer;
FUNCTION RSt(R:real; Decimals:INTEGER):String80;
FUNCTION RNr(S:String):real;
Function Power(Mantissa, Exponent:Real):Real;
PROCEDURE Get_Screen_Mode;
PROCEDURE Get_Country;
PROCEDURE Cursor(Top,Bottom:Byte);
PROCEDURE Cursor_Off;
Procedure Reset_Screen_Colors;
Procedure Change_Color(Oldattr,NewAttr:Byte);
Function Get_Current_Color(Attr:Byte):Byte;
PROCEDURE Set_Edit_Mode(Yes:BOOLEAN);
PROCEDURE Set_Att(X,Y:INTEGER;Color:Byte);
PROCEDURE Dc(X,Y,Charcode:Byte);
PROCEDURE Draw_Char(Charcode:Byte);
PROCEDURE Set_Screen_Color(Color:Byte);
PROCEDURE Set_Field_Color(Fieldnr:INTEGER;Color:Byte);
function format_name:string80;
FUNCTION Get_Att(X,Y:INTEGER):Byte;
PROCEDURE Paint_Format_Frame(Color:Byte);
PROCEDURE Set_Mx(Value:INTEGER);
PROCEDURE Set_My(Value:INTEGER);
FUNCTION Exist(Fn : String80):BOOLEAN;
FUNCTION Date_String(Y,M,D:word):String10;
FUNCTION Time_String(H,M,S:word):String10;
PROCEDURE Check_Time(VAR Time_Str:String10;VAR H,M,S:word);
PROCEDURE Check_Date(VAR Date_Str:String10;VAR Y,M,D:word);
FUNCTION Weekday(Y,M,D:word):word;
FUNCTION Julian_Date(VAR Y,M,D:word):REAL;
Procedure Normal_Date(Julian:REAL;VAR Y,M,D:word);
FUNCTION Date:String10;
FUNCTION Time(Seconds:BOOLEAN):String10;
FUNCTION Environment(Env_Name:String128):String128;
PROCEDURE Execute(Progstring:String128);
PROCEDURE ExecuteDos(Command:String128);
FUNCTION Next_Char(VAR Esc:BOOLEAN):CHAR;
FUNCTION Rtime:REAL;
PROCEDURE Beep;
PROCEDURE Fatal_Scl_Error(Errornr:INTEGER);
PROCEDURE W_Crt(Fieldnr:INTEGER;Msg:String80);
FUNCTION Sys_Msg(Nr:INTEGER):String80;
PROCEDURE Input_Error(Msgnr:INTEGER);
PROCEDURE R_Cont(Fieldnr:INTEGER;VAR Contents:String80);
PROCEDURE R_Sel(Fieldnr:INTEGER; VAR Sel:BOOLEAN);
FUNCTION G_Cont(Fn:INTEGER):String80;
FUNCTION G_Sel(Fn:INTEGER):BOOLEAN;
PROCEDURE Finish_Format(Check:BOOLEAN);
PROCEDURE Close_Formats;
PROCEDURE Select_Format_File(Filename:String10);
PROCEDURE Blank_Format;
PROCEDURE Select_Format(Fname:String10);
PROCEDURE Get_Next_Char(VAR Charnumber:INTEGER ; VAR Inputchar:CHAR);
PROCEDURE W_Cont(Fieldnr:INTEGER;Cont:String80);
PROCEDURE W_Sel(Fieldnr:INTEGER;Sel:BOOLEAN);
PROCEDURE C_Cont(Fieldnr:INTEGER);
FUNCTION Format_Done:BOOLEAN;
PROCEDURE Goto_Field(Fn:INTEGER);
PROCEDURE Display_Format(Xoffset,Yoffset:INTEGER);
PROCEDURE Handle_Format;
(* --------Datacom Routines----------- *)
PROCEDURE Clear_Rx_Buffer;
PROCEDURE Set_Dc_Params;
PROCEDURE Get_Dc_Status(VAR Status:INTEGER);
PROCEDURE Dc_Break;
FUNCTION Cts:BOOLEAN;
FUNCTION Dsr:BOOLEAN;
FUNCTION Ri:BOOLEAN;
PROCEDURE Set_Rts(On:BOOLEAN);
PROCEDURE Set_Dtr(On:BOOLEAN);
PROCEDURE Enable_Port;
PROCEDURE Disable_Port;
PROCEDURE Dc_Diagnose(On:BOOLEAN);
PROCEDURE Close_Dc;
PROCEDURE Open_Dc(VAR Result:INTEGER);
PROCEDURE Dc_Write(Code:Byte;VAR Ok:BOOLEAN);
FUNCTION Tx_Ok:BOOLEAN;
PROCEDURE Send_Char(Code:Byte;var Ok:BOOLEAN);
PROCEDURE Send_String(Data:String;VAR Ok:BOOLEAN);
PROCEDURE Send_Buffer(VAR Tx_Buff;Buff_Start,Buff_Length,Bcc_add:INTEGER;
Head:string;VAR Ok:BOOLEAN);
PROCEDURE Receive_Char(VAR Code:INTEGER;VAR Ok:BOOLEAN);
implementation